perm filename UPGETL.NEW[1,JRA] blob
sn#022403 filedate 1973-02-01 generic text, type T, neo UTF8
00100
00150 (DE *CL(C)(UPGETL1 C XYZ1(CONS(CONS @CLAUSES XYZ1)NEWNAME)) )
00200
00300 (DEFPROP UPGETL
00400 (LAMBDA(E N)
00500 (PROG (C)
00600 (SCANSET)
00700 (START)
00800 (SETQ C (ERRSET (<CLAUSES>) T))
00900 (SCANRESET)
01000 (COND ((OR (NULL C) (NULL (CAR C))) (PRINT (QUOTE LOSSAGE-IN-CLAUSES)) (RETURN NIL)))
01100 (SETQ C (TOP))
01200 (COND ((EQ C (QUOTE EMPTY)) (RETURN NIL)))
01250 (RETURN(UPGETL1 C E N))))EXPR)
01275 (DEFPROP UPGETL1(LAMBDA(C E N)
01287 (PROG(N1 Z Z1 Z2 Z3 ZZ N2)
01300 AS1 (SETQ Z (CAR C))
01400 (COND ((ATOM Z)
01500 (COND ((NUMBERP Z) (SETQ N2 (QUOTE CLAUSES))
01600 (COND ((SETQ Z1 (DOWN Z E)) (SETQ ZZ (APPENDIT ZZ (LIST (CAR Z1)))))
01700 (T (RETURN NIL))))
01800 ((SETQ Z1 (GETNAME Z N)) (SETQ N2 Z) (SETQ ZZ (APPENDIT ZZ Z1)))
01900 (T (RETURN NIL))))
02000 ((EQ (CAR Z) (QUOTE STAT)) (GO AS10))
02100 ((EQ (CAR Z) (QUOTE FIND)) (GO AS20))
02200 ((EQ (CAR Z) (QUOTE DSK)) (GO AS30))
02300 ((SETQ Z1 (GETNAME (CAR Z) N)) (SETQ N2 (CAR Z)) (GO AS2))
02400 (T (RETURN NIL)))
02500 AS6 (SETQ C (CDR C))
02600 (COND (C (GO AS1)) (T (RETURN ZZ)))
02700 AS2 (SETQ Z2 (CADR Z))
02800 (SETQ N1 (CAR Z))
02900 (SETQ Z (CDR Z))
03000 (SETQ Z3 Z1)
03100 AS2A (COND ((NOT (NUMBERP Z2)) (PRINT (QUOTE NON-NUMERIC-ARG-FOR:)) (PRINC N1) (RETURN NIL)))
03200 AS3 (SETQ Z2 (SUB1 Z2))
03300 (COND ((ZEROP Z2) (GO AS4)))
03400 (SETQ Z1 (CDR Z1))
03500 (COND (Z1 (GO AS3)) (T (PRINT (QUOTE EXCEEDED-SIZE-OF:)) (PRINC N1) (RETURN NIL)))
03600 AS4 (COND
03700 ((NOT (HERE (CAR Z1))) (PRINT N1)
03800 (PRINC (QUOTE / ))
03900 (PRINC (CAR Z))
04000 (PRINC (QUOTE / ))
04100 (PRINC (QUOTE HAS-BEEN-DELETED))
04200 (RETURN NIL)))
04300 (SETQ ZZ (APPENDIT ZZ (LIST (CAR Z1))))
04400 (SETQ Z (CDR Z))
04500 (COND (Z (SETQ Z1 Z3) (SETQ Z2 (CAR Z)) (GO AS2A)))
04600 (GO AS6)
04700 AS10 (SETQ N2 (QUOTE INSERT))
04800 (SETQ ZZ (APPENDIT ZZ (SET3 (SETUP (CNF (FIXQFF (CDR Z)))))))
04900 (GO AS6)
05000 AS20 (SETQ N2 (QUOTE MATCHES))
05100 (SETQ Z (MAPIT (CADR Z) (LIST (QUOTE FUNCTION) (LIST (QUOTE LAMBDA) (QUOTE (C)) (CADDR Z))) N))
05200 (COND ((NULL Z) (GO AS6)) (T (GO AS31)))
05300 AS30 (SETQ N2 (QUOTE INPUT))
05400 (SETQ ZIN (CDR Z))
05500 (COND
05600 ((NULL (ERRSET (EVAL (LIST (QUOTE INPUT) (QUOTE DSK:) ZIN)))) (PRINT (QUOTE CONTINUING)) (GO AS6)))
05700 (INC T)
05800 (SETQ Z (INCLAUSES))
05900 (INC NIL)
06000 (COND ((NULL Z) (RETURN NIL)))
06100 AS31 (SETQ ZZ (APPENDIT ZZ Z))
06200 (GO AS6)))
06300 EXPR)